home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / MacPerl5 / MPScript.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-01-26  |  20.2 KB  |  986 lines  |  [TEXT/MPS ]
  1. /*********************************************************************
  2. Project    :    MacPerl            -    Real Perl Application
  3. File        :    MPScript.c        -    Handle scripts
  4. Author    :    Matthias Neeracher
  5. Language    :    MPW C
  6.  
  7. $Log: MPScript.c,v $
  8. Revision 1.2  1994/05/04  02:54:19  neeri
  9. Always keep the right resource file in front.
  10.  
  11. Revision 1.1  1994/02/27  23:01:56  neeri
  12. Initial revision
  13.  
  14. Revision 0.2  1993/10/14  00:00:00  neeri
  15. Run front window
  16.  
  17. Revision 0.1  1993/08/17  00:00:00  neeri
  18. Set up correct default directory
  19.  
  20. *********************************************************************/
  21.  
  22. #define ORIGINAL_WRAPPER
  23.  
  24. #include <AERegistry.h>
  25. #include <String.h>
  26. #include <TFileSpec.h>
  27. #include <sys/types.h>
  28. #include <ctype.h>
  29. #include <stdio.h>
  30. #include <fcntl.h>
  31. #include <unistd.h>
  32. #include <Signal.h>
  33. #include <StandardFile.h>
  34. #include <Resources.h>
  35. #include <PLStringFuncs.h>
  36. #include <LowMem.h>
  37. #include <FragLoad.h>
  38. #include <AEBuild.h>
  39. #include <AEStream.h>
  40. #include <AESubDescs.h>
  41. #include <OSA.h>
  42.  
  43. #include "MPScript.h"
  44. #include "MPWindow.h"
  45. #include "MPAppleEvents.h"
  46. #include "MPAEVTStream.h"
  47. #include "MPFile.h"
  48. #include "MPSave.h"
  49. #include "MPMain.h"
  50. #include "MPPreferences.h"
  51. #include "icemalloc.h"
  52.  
  53. static FSSpec ** sStandardScripts;
  54.  
  55. pascal Boolean GetScriptFilter(CInfoPBPtr pb)
  56. {
  57.     switch (GetDocTypeFromInfo(pb)) {
  58.     case kPreferenceDoc:
  59.         /* We don't want preference files here. */
  60.     case kUnknownDoc:
  61.         return true;
  62.     default:
  63.         return false;
  64.     }
  65. }
  66.  
  67. #if USESROUTINEDESCRIPTORS
  68. RoutineDescriptor    uGetScriptFilter = 
  69.         BUILD_ROUTINE_DESCRIPTOR(uppFileFilterProcInfo, GetScriptFilter);
  70. #endif
  71.  
  72. void PopupOffending(AEDesc * repl)
  73. {
  74.     OSErr                        err;
  75.     AEDesc                    target;
  76.     short                        line;
  77.     DescType                    type;
  78.     Size                        size;
  79.     FSSpec                    file;
  80.     
  81.     if (AEGetParamPtr(repl, kOSAErrorOffendingObject, typeFSS, &type, &file, sizeof(FSSpec), &size))
  82.         return;
  83.     if (AEGetKeyDesc(repl, kOSAErrorRange, typeWildCard, &target))
  84.         return;
  85.     err = AEGetKeyPtr(&target, keyOSASourceStart, typeShortInteger, &type, &line, sizeof(short), &size);
  86.     AEDisposeDesc(&target);
  87.     if (err)
  88.         return;
  89.     IssueJumpCommand(&file, nil, line);
  90. }
  91.  
  92. static void SendScriptEvent(
  93.     DescType argType, 
  94.     Ptr         argPtr, 
  95.     Handle    argHdl,
  96.     Size         argSize, 
  97.     Boolean    syntax,
  98.     FSSpec *    dir)
  99. {
  100.     OSErr                    err;
  101.     AppleEvent            cmd, repl;
  102.     AEAddressDesc        addr;
  103.     AEStream                aes;
  104.     
  105.     if (err = MakeSelfAddress(&addr))
  106.         goto failedAddress;
  107.         
  108.     if (err = 
  109.         AECreateAppleEvent(
  110.             kAEMiscStandards, kAEDoScript, &addr, 
  111.             kAutoGenerateReturnID, kAnyTransactionID, 
  112.             &cmd)
  113.     )
  114.         goto failedAppleEvent;
  115.     
  116.     if (err = AEStream_OpenEvent(&aes, &cmd))
  117.         goto failedStream;
  118.     
  119.     err = AEStream_WriteKey(&aes, keyDirectObject);
  120.     
  121.     if (!err)
  122.         if (argHdl) {
  123.             AEDesc    arg;
  124.             
  125.             arg.descriptorType    =    argType;
  126.             arg.dataHandle            =    argHdl;
  127.             
  128.             err = AEStream_WriteAEDesc(&aes, &arg);
  129.         } else
  130.             err = AEStream_WriteDesc(&aes, argType, argPtr, argSize);
  131.     
  132.     if (!err)    
  133.         if (syntax)
  134.             err = AEStream_WriteKeyDesc(
  135.                         &aes, 'CHCK', typeBoolean, (Ptr) &syntax, sizeof(Boolean));
  136.         else {
  137.             if (gDebug)
  138.                 err =    AEStream_WriteKeyDesc(
  139.                             &aes, 'DEBG', typeBoolean, (Ptr) &gDebug, sizeof(Boolean));
  140.             if (!err && gWarnings)
  141.                 err =    AEStream_WriteKeyDesc(
  142.                             &aes, 'WARN', typeBoolean, (Ptr) &gWarnings, sizeof(Boolean));
  143.         }
  144.     if (!err && dir)
  145.         err =    AEStream_WriteKeyDesc(&aes, 'DIRE', typeFSS, (Ptr) dir, sizeof(FSSpec));    
  146.                     
  147.     if (err)
  148.         AEStream_Close(&aes, nil);
  149.     else 
  150.         err = AEStream_Close(&aes, &cmd);
  151.     
  152.     if (err)
  153.         goto failedStream;
  154.         
  155.     if (AESend(&cmd, &repl,
  156.             kAEWaitReply+kAEAlwaysInteract, kAENormalPriority, kAEDefaultTimeout,
  157.             nil, nil)
  158.     && !gQuitting
  159.     ) 
  160.         PopupOffending(&repl);
  161.  
  162.     AEDisposeDesc(&repl);
  163. failedStream:
  164.     AEDisposeDesc(&cmd);
  165. failedAppleEvent:
  166.     AEDisposeDesc(&addr);
  167. failedAddress:
  168.     ;
  169. }
  170.  
  171. pascal void DoScriptMenu(short theItem)
  172. {
  173.     StandardFileReply    reply;
  174.     FSSpec                dir;
  175.  
  176.     BuildSEList();
  177.     
  178.     switch (theItem) {
  179.     default:
  180.         reply.sfFile = (*sStandardScripts)[theItem-pmStandard];
  181.         dir = reply.sfFile;
  182.         FSpUp(&dir);
  183.         SendScriptEvent(
  184.             typeFSS, (Ptr) &reply.sfFile, nil, sizeof(FSSpec), 
  185.             false, &dir);
  186.         break;
  187.     case pmRun:
  188.     case pmCheckSyntax:
  189.         StandardGetFile(&uGetScriptFilter, MacPerlFileTypeCount, MacPerlFileTypes, &reply);
  190.         if (reply.sfGood) {
  191.             dir = reply.sfFile;
  192.             FSpUp(&dir);
  193.             SendScriptEvent(
  194.                 typeFSS, (Ptr) &reply.sfFile, nil, sizeof(FSSpec), 
  195.                 theItem == pmCheckSyntax, &dir);
  196.         }
  197.         break;
  198.     case pmRunFront:
  199.     case pmCheckFront:
  200.         {
  201.             WindowPtr    win;
  202.             DPtr            doc;
  203.             
  204.             for (win = FrontWindow(); win; win = GetNextWindow(win)) {
  205.                 if (!IsWindowVisible(win) || !Ours(win))
  206.                     continue;
  207.                 if ((doc = DPtrFromWindowPtr(win)) && doc->kind == kDocumentWindow)
  208.                     break;
  209.             }
  210.             
  211.             if (!win)
  212.                 break;
  213.             
  214.             if (doc->u.reg.everSaved) {
  215.                 dir = doc->theFSSpec;
  216.             } else {    
  217.                 dir.vRefNum    =     gAppVol;
  218.                 dir.parID    =    gAppDir;
  219.             }
  220.             FSpUp(&dir);
  221.             
  222.             if (doc->dirty || !doc->u.reg.everSaved) {
  223.                 if (doc->u.reg.everSaved)
  224.                     strcpy(gPseudoFileName, FSp2FullPath(&doc->theFSSpec));
  225.                 else
  226.                     getwtitle(win, gPseudoFileName);
  227.  
  228.                 SendScriptEvent(
  229.                     typeChar, nil, (*doc->theText)->hText, 
  230.                     GetHandleSize((*doc->theText)->hText),
  231.                     theItem == pmCheckFront, &dir);
  232.             } else {
  233.                 gPseudoFileName[0] = 0;
  234.                 SendScriptEvent(
  235.                     typeFSS, (Ptr) &doc->theFSSpec, nil, sizeof(FSSpec), 
  236.                     theItem == pmCheckFront, &dir);
  237.             }
  238.         }
  239.         break;
  240.     case pmWarnings:
  241.         gWarnings = !gWarnings;
  242.         CheckItem(myMenus[perlM], pmWarnings, gWarnings);
  243.         break;
  244.     case pmDebug:
  245.         gDebug = !gDebug;
  246.         CheckItem(myMenus[perlM], pmDebug, gDebug);
  247.         break;
  248.     }
  249. }
  250.  
  251. typedef void (*atexitfn)();
  252.  
  253. void MP_Exit(int status)
  254. {
  255.     if (gRunningPerl)
  256.         longjmp(gExitPerl, -status-1);
  257.     else {
  258.         exit(status);
  259.     }
  260. }
  261.  
  262. static atexitfn     PerlExitFn[20];
  263. static int            PerlExitCnt;
  264.  
  265. int MP_AtExit(atexitfn func)
  266. {
  267.     if (gRunningPerl)
  268.         PerlExitFn[PerlExitCnt++] = func;
  269.     else {
  270.         return atexit(func);
  271.     }
  272.         
  273.     return 0;
  274. }
  275.  
  276. static char **        PerlArgs;
  277. static int            PerlArgMax;
  278. static char **        PerlEnviron;
  279. static Handle        PerlEnvText;
  280.  
  281. char * MP_GetEnv(const char * var)
  282. {
  283.     char **     env;
  284.     
  285.     for (env = PerlEnviron; *env; ++env)
  286.         if (equalstring(*env, var, false, true))
  287.             return *env + strlen(*env) + 1;
  288.         
  289.     return nil;
  290. }
  291.  
  292. pascal void InitPerlEnviron()
  293. {
  294.     gDebugLogName     = "Dev:Console:Debug Log";
  295.     gExit                = MP_Exit;
  296.     gAtExit            = MP_AtExit;
  297.     gGetEnv            = MP_GetEnv;
  298.     gAlwaysExtract    = true;
  299.     gHandleEvent    = HandleEvent;
  300. }
  301.  
  302. pascal Handle MakeLibraries()
  303. {
  304.     char        end = 0;
  305.     int        libCount;
  306.     short        resFile;
  307.     char *    libpath;
  308.     FSSpec    libspec;
  309.     Handle    libs;
  310.     Str255    lib;
  311.  
  312.     if (libs = gCachedLibraries)
  313.         goto haveLibs;
  314.     
  315.     PtrToHand("MACPERL", &libs, 8);
  316.     libspec.vRefNum        =     gAppVol;
  317.     libspec.parID            =    gAppDir;
  318.     FSpUp(&libspec);
  319.     libpath                  =    FSp2FullPath(&libspec);
  320.     libCount                    =    strlen(libpath);
  321.     PtrAndHand(libpath, libs, libCount);
  322.     PtrAndHand(":",     libs, 2);
  323.     
  324.     PtrAndHand("PERL5LIB", libs, 9);
  325.     
  326.     resFile = CurResFile();
  327.     OpenPreferences();
  328.     if (gPrefsFile) {
  329.         UseResFile(gPrefsFile);
  330.         
  331.         for (libCount = 1; ; ++libCount) {
  332.             GetIndString(lib, LibraryPaths, libCount);
  333.             
  334.             if (!lib[0])
  335.                 break;
  336.             
  337.             if (lib[1] == ':') {
  338.                 char *    libpath;
  339.                 FSSpec    libspec;
  340.             
  341.                 libspec.vRefNum    =     gAppVol;
  342.                 libspec.parID        =    gAppDir;
  343.                 memcpy(libspec.name+1, lib+2, *libspec.name = *lib-1);
  344.             
  345.                 libpath  = FSp2FullPath(&libspec);
  346.                 memcpy(lib+1, libpath, *lib = strlen(libpath));
  347.             }
  348.                 
  349.             if (libCount > 1)
  350.                 PtrAndHand(",", libs, 1);
  351.             
  352.             PtrAndHand(lib+1, libs, lib[0]);
  353.         }
  354.         CloseResFile(gPrefsFile);
  355.     }
  356.     PtrAndHand(&end, libs, 1);
  357.     
  358.     UseResFile(resFile);
  359.     
  360.     gCachedLibraries = libs;
  361.  
  362. haveLibs:
  363.     HandToHand(&libs);
  364.     
  365.     return libs;
  366. }
  367.  
  368. /* Build environment from AEDescriptor passed in 'ENVT' parameter */
  369.  
  370. void MakePerlEnviron(AEDesc * desc)
  371. {
  372.     Handle        envText  = MakeLibraries();
  373.     int            index;
  374.     int            libOffset;
  375.     int            totalLength;
  376.     int            envCount = 2;
  377.     void *         curName;
  378.     void *         curValue;
  379.     long            curNameLen;
  380.     long            curValueLen;
  381.     char *        text;
  382.     AEKeyword    key;
  383.     AESubDesc    strings;
  384.     AESubDesc    cur;    
  385.     
  386.     HLock(envText);
  387.     libOffset =        strlen(*envText)+1;
  388.     libOffset +=    strlen(*envText+libOffset)+1;
  389.     libOffset +=    strlen(*envText+libOffset)+1;
  390.     HUnlock(envText);
  391.     
  392.     if (desc) {
  393.         HLock(desc->dataHandle);
  394.         AEDescToSubDesc(desc, &strings); 
  395.         
  396.         for (index = 0; !AEGetNthSubDesc(&strings, ++index, &key, &cur); ) {
  397.             curName = AEGetSubDescData(&cur, &curNameLen);
  398.             
  399.             if (AEGetNthSubDesc(&strings, ++index, &key, &cur))
  400.                 curValue = nil;
  401.             else
  402.                 curValue = AEGetSubDescData(&cur, &curValueLen);
  403.             
  404.             if (!memcmp(curName, "PERL5LIB", 9)) {
  405.                 if (curValue) {
  406.                     Munger(envText, libOffset, nil, 0, curValue, curValueLen+1);
  407.                     (*envText)[libOffset+curValueLen] = ',';
  408.                 }
  409.             } else {
  410.                 ++envCount;
  411.                 
  412.                 totalLength = GetHandleSize(envText);
  413.                 
  414.                 PtrAndHand(curName, envText, curNameLen+1);
  415.                 
  416.                 (*envText)[totalLength+curNameLen] = 0;
  417.                 
  418.                 if (curValue) {
  419.                     PtrAndHand(curValue, envText, curValueLen+1);
  420.                 
  421.                     (*envText)[totalLength+curNameLen+curValueLen+1] = 0;
  422.                 } else {
  423.                     PtrAndHand(curName, envText, 1);
  424.                 
  425.                     (*envText)[totalLength+curNameLen+1] = 0;
  426.                 }
  427.             }
  428.         }
  429.     }
  430.     
  431.     if (PerlEnvText) {
  432.         DisposePtr((Ptr) PerlEnviron);
  433.         DisposeHandle(PerlEnvText);
  434.     }
  435.  
  436.     MoveHHi(PerlEnvText = envText);
  437.     HLock(envText);
  438.         
  439.     PerlEnviron                 = (char **) NewPtr((envCount+1) * sizeof(char *));
  440.     PerlEnviron[envCount]     = nil;
  441.     text                            = *envText;
  442.     
  443.     while (envCount--) {
  444.         PerlEnviron[envCount]    = text;
  445.         text                           += strlen(text) + 1;
  446.         text                           += strlen(text) + 1;
  447.     }
  448. }
  449.  
  450. void CleanupPerl()
  451. {
  452.     int i;
  453.     extern FILE * _lastbuf;
  454.  
  455.     UseResFile(gAppFile);
  456.  
  457.     // Borrowed from GUSI
  458.     
  459.     // Close stdio files (necessary to flush buffers)
  460.     // This implementation is not nice, but who cares ?
  461.     // In case you wonder, _iob is defined in <stdio.h>
  462.  
  463.     fwalk(fflush);
  464.     fwalk(fclose);
  465.  
  466.     // Close all files
  467.  
  468.     for (i = 0; i<FD_SETSIZE; ++i)
  469.         close(i);
  470.  
  471.     while (PerlExitCnt)
  472.         PerlExitFn[--PerlExitCnt]();
  473.  
  474.     UseResFile(gAppFile);
  475.  
  476.     /* free_pool_memory('PERL'); */
  477.  
  478.     freopen("Dev:Console", "r", stdin);
  479.     freopen("Dev:Console", "w", stdout);
  480.     setvbuf(stdout, NULL, _IOLBF, BUFSIZ);
  481.     freopen("Dev:Console", "w", stderr); 
  482.     setvbuf(stderr, NULL, _IOLBF, BUFSIZ);
  483. }
  484.  
  485. enum {
  486.     extractDone            = -6,
  487.     extractSyntax        = -5,
  488.     extractWarn            = -4,
  489.     extractDir            = -3,
  490.     extractCpp            = -2,
  491.     extractDebug         = -1
  492. };
  493.  
  494. typedef char * (*ArgExtractor)(void * data, int index);
  495.  
  496. pascal Boolean RunScript(ArgExtractor extractor, void * data)
  497. {
  498.     int        ArgC;
  499.     char    *    res;
  500.     int        i;
  501.     int         DynamicArgs;
  502.     int        returnCode;
  503.     Boolean    wasRuntime;
  504.     
  505.     wasRuntime    = gRuntimeScript != 0;
  506.     ArgC            = 1;
  507.     PerlArgMax    = 20;
  508.     PerlArgs     = malloc(PerlArgMax * sizeof(char *));
  509.     PerlArgs[0]    = "MacPerl";
  510.     
  511.     {
  512.         char        path[256];
  513.     
  514.         strcpy(path, extractor(data, extractDir));
  515.         chdir(path);
  516.     }
  517.     
  518.     if ((res = extractor(data, extractSyntax)) && *res == 'y')
  519.         PerlArgs[ArgC++] = "-c";
  520.  
  521.     if (((res = extractor(data, extractWarn)) && *res == 'y') || gWarnings)
  522.         PerlArgs[ArgC++] = "-w";
  523.  
  524.     if (((res = extractor(data, extractDebug)) && *res == 'y') || gDebug)
  525.         PerlArgs[ArgC++] = "-d";
  526.  
  527.     if ((res = extractor(data, extractCpp)) && *res == 'y')
  528.         PerlArgs[ArgC++] = "-P";
  529.  
  530.     DynamicArgs = ArgC;
  531.     
  532.     if (res = extractor(data, 1)) {
  533.         if (gPerlPrefs.checkType && !gPseudoFile) 
  534.             PerlArgs[ArgC++] = "-x";
  535.         
  536.         DynamicArgs         = ArgC;
  537.         
  538.         PerlArgs[ArgC++]     = res;
  539.     
  540.         for (i=2; PerlArgs[ArgC] = extractor(data, i); ++i)
  541.             if (++ArgC == PerlArgMax) {
  542.                 PerlArgMax    += 20;
  543.                 PerlArgs     = realloc(PerlArgs, PerlArgMax * sizeof(char *));
  544.             }
  545.     }
  546.     
  547.     extractor(data, extractDone);
  548.     
  549.     UseResFile(gAppFile);
  550.     
  551.     PerlArgs[ArgC] =  nil;
  552.     gRunningPerl     =  true;
  553.     gPerlQuit        =    0;
  554.     gFirstErrorLine= -1;
  555.     
  556.     ShowWindowStatus();
  557.     
  558.     signal(SIGINT, exit);
  559.     
  560.     if (!(returnCode = setjmp(gExitPerl))) {
  561.         run_perl(ArgC, PerlArgs, PerlEnviron);
  562.         /* Noone here gets out alive */
  563.     }    
  564.  
  565.     for (i=DynamicArgs; PerlArgs[i]; ++i)
  566.         DisposPtr(PerlArgs[i]);
  567.  
  568.     free(PerlArgs);
  569.  
  570.     CleanupPerl();
  571.     gRunningPerl = false;
  572.     
  573.     if (gScriptFile != gAppFile) {
  574.         CloseResFile(gScriptFile);
  575.         
  576.         gScriptFile = gAppFile;
  577.     }
  578.     
  579.     ShowWindowStatus();
  580.     
  581.     ++gCompletedScripts;
  582.     
  583.     switch (gPerlQuit) {
  584.     case 1:
  585.         /* 1: Quit if run in a standalone runtime */
  586.         if (!wasRuntime)
  587.             break;
  588.     case 3:
  589.         /* 3: Quit if this script was the cause of MacPerl being run */
  590.         if (gCompletedScripts > 1)
  591.             break;
  592.     case 2:
  593.         /* 2: Always quit */
  594.         DoQuit(kAEAsk);
  595.     case 0:
  596.         /* 0: Never quit */
  597.         ;
  598.     }
  599.     
  600.     return returnCode == -1;
  601. }
  602.  
  603. char * MakePath(char * path)
  604. {
  605.     char * retarg = NewPtr(strlen(path)+1);
  606.     
  607.     if (retarg)        
  608.         strcpy(retarg, path);
  609.             
  610.     return retarg;
  611. }
  612.  
  613. char * AEExtractor(void * data, int index)
  614. {
  615.     static Boolean            hasParams = false;
  616.     static AEDesc            params;
  617.     static AESubDesc        paramList;
  618.     static int                scriptIndex;
  619.     
  620.     AppleEvent *     event;
  621.     AESubDesc        sd;
  622.     AEKeyword        noKey;
  623.     AEDesc            desc;
  624.     FSSpec            script;
  625.     FSSpec            arg;
  626.     Size                size;
  627.     char *            retarg;
  628.     DescType            type;
  629.     Boolean            flag;
  630.     
  631.     event = (AppleEvent *) data;
  632.     
  633.     if (!hasParams) {
  634.         AEGetParamDesc(event, keyDirectObject, typeAEList, ¶ms);
  635.         AEDescToSubDesc(¶ms, ¶mList);
  636.         hasParams = true;
  637.         scriptIndex = 0; 
  638.         
  639.         if (gRuntimeScript)
  640.             gPseudoFile = gRuntimeScript;
  641.         else
  642.             while (!AEGetNthSubDesc(¶mList, ++scriptIndex, &noKey, &sd)) {
  643.                 if (!AESubDescToDesc(&sd, typeFSS, &desc)) {
  644.                     script = **(FSSpec **) desc.dataHandle;
  645.                     
  646.                     AEDisposeDesc(&desc);
  647.                     
  648.                     break;
  649.                 } 
  650.                 if (AESubDescToDesc(&sd, typeChar, &desc))
  651.                     continue;
  652.                 if ((*desc.dataHandle)[0] == '-') {
  653.                     AEDisposeDesc(&desc);
  654.                     
  655.                     continue;
  656.                 } else {
  657.                     if (!gPseudoFileName[0])
  658.                         strcpy(gPseudoFileName, "<AppleEvent>");
  659.                     gPseudoFile = desc.dataHandle;
  660.                     
  661.                     break;
  662.                 }
  663.             }
  664.     }
  665.     
  666.     switch (index) {
  667.     case extractDone:
  668.         gRuntimeScript = nil;
  669.  
  670.         if (hasParams)
  671.             AEDisposeDesc(¶ms);
  672.             
  673.         hasParams        = false;
  674.  
  675.         return nil;
  676.     case extractDir:
  677.         if (gPseudoFile) {
  678.             script.vRefNum    =    gAppVol;
  679.             script.parID    =    gAppDir;
  680.         } else {
  681.             short    res    = CurResFile();
  682.             
  683.             gScriptFile = HOpenResFile(script.vRefNum, script.parID, script.name, fsRdPerm);
  684.             
  685.             if (gPseudoFile    =     Get1NamedResource('TEXT', (StringPtr) "\p!")) {
  686.                 strcpy(gPseudoFileName, FSp2FullPath(&script));
  687.                 
  688.                 DetachResource(gPseudoFile);
  689.             }
  690.  
  691.             UseResFile(res);
  692.         } 
  693.         if (!AEGetParamPtr(
  694.             event, 'DIRE', typeFSS, &type, (Ptr) &arg, sizeof(FSSpec), &size)
  695.         ) 
  696.             script = arg;
  697.         else
  698.             FSpUp(&script);
  699.         
  700.         return FSp2FullPath(&script);
  701.     case extractDebug:
  702.         if (AEGetParamPtr(event, 'DEBG', typeBoolean, &type, (Ptr) &flag, 1, &size))
  703.             return nil;
  704.         else
  705.             return flag ? "y" : "n";
  706.     case extractCpp:
  707.         if (AEGetParamPtr(event, 'PREP', typeBoolean, &type, (Ptr) &flag, 1, &size))
  708.             return nil;
  709.         else
  710.             return flag ? "y" : "n";
  711.     case extractSyntax:
  712.         if (AEGetParamPtr(event, 'CHCK', typeBoolean, &type, (Ptr) &flag, 1, &size))
  713.             return nil;
  714.         else
  715.             return flag ? "y" : "n";
  716.     case extractWarn:
  717.         if (AEGetParamPtr(event, 'WARN', typeBoolean, &type, (Ptr) &flag, 1, &size))
  718.             return nil;
  719.         else
  720.             return flag ? "y" : "n";
  721.     default:
  722.         /* A runtime script inserts itself at the beginning */
  723.         if (gRuntimeScript)
  724.             --index;
  725.         
  726.         if (index == scriptIndex && gPseudoFile)
  727.             return MakePath("Dev:Pseudo");
  728.         
  729.         /* End of list ? */
  730.         if (AEGetNthSubDesc(¶mList, index, &noKey, &sd))
  731.             return nil;
  732.  
  733.         if (!AESubDescToDesc(&sd, typeFSS, &desc)) {
  734.             arg = **(FSSpec **) desc.dataHandle;
  735.             
  736.             AEDisposeDesc(&desc);
  737.             
  738.             /* A file, convert to a path name */
  739.             retarg = FSp2FullPath(&arg);
  740.             
  741.             return MakePath(retarg);
  742.         } else if (!AESubDescToDesc(&sd, typeChar, &desc)) {
  743.             size         = GetHandleSize(desc.dataHandle);
  744.             retarg     = NewPtr(size+1);
  745.             
  746.             if (retarg) {
  747.                 retarg[size] = 0;
  748.             
  749.                 memcpy(retarg, *desc.dataHandle, size);
  750.             }
  751.                     
  752.             AEDisposeDesc(&desc);
  753.             
  754.             return retarg;
  755.         }
  756.         
  757.         return nil;
  758.     }            
  759. }
  760.  
  761. char * StupidExtractor(void * data, int index)
  762. {
  763.     FSSpec    *        spec;
  764.     FSSpec            dir;
  765.     char *            retarg;
  766.     char *            path;
  767.     
  768.     spec = (FSSpec *) data;
  769.     
  770.     switch (index) {
  771.     case extractDone:
  772.     case extractDebug:
  773.     case extractCpp:
  774.         return nil;
  775.     case extractDir:
  776.         dir = *spec;
  777.         
  778.         {
  779.             short    res    = CurResFile();
  780.             
  781.             gScriptFile = HOpenResFile(dir.vRefNum, dir.parID, dir.name, fsRdPerm);
  782.             
  783.             if (gPseudoFile    =     Get1NamedResource('TEXT', (StringPtr) "\p!")) {
  784.                 strcpy(gPseudoFileName, FSp2FullPath(spec));
  785.                 
  786.                 DetachResource(gPseudoFile);
  787.             }
  788.             
  789.             UseResFile(res);
  790.         } 
  791.         
  792.         FSpUp(&dir);
  793.         
  794.         return FSp2FullPath(&dir);
  795.     default:
  796.         if (index > 1)
  797.             return nil;
  798.  
  799.         if (gPseudoFile)
  800.             return "Dev:Pseudo";
  801.             
  802.         path = FSp2FullPath(spec);
  803.         retarg = NewPtr(strlen(path)+1);
  804.             
  805.         strcpy(retarg, path);
  806.             
  807.         return retarg;
  808.     }            
  809. }
  810.  
  811. void AddErrorDescription(AppleEvent * reply)
  812. {
  813.     OSErr            err;
  814.     AliasHandle    file;
  815.     AEStream        aes;
  816.     AEDesc      newDesc;
  817.     short            line;
  818.  
  819.     if (gFirstErrorLine == -1 || reply->descriptorType == typeNull) 
  820.         return;
  821.     
  822.     line = (short) gFirstErrorLine;
  823.     
  824.     if (NewAlias(nil, &gFirstErrorFile, &file)) 
  825.         return;
  826.         
  827.     HLock((Handle) file);
  828.     err = AEPutParamPtr(
  829.                 reply, kOSAErrorOffendingObject, 
  830.                 typeAlias, (Ptr) *file, GetHandleSize((Handle) file));
  831.     DisposHandle((Handle) file);
  832.         
  833.     if (err)
  834.         return;
  835.         
  836.     if (AEStream_Open(&aes))
  837.         return;
  838.         
  839.     if (AEStream_OpenRecord(&aes, typeAERecord)
  840.     ||     AEStream_WriteKeyDesc(&aes, keyOSASourceStart, typeShortInteger, (Ptr) &line, 2)
  841.     ||     AEStream_WriteKeyDesc(&aes, keyOSASourceEnd, typeShortInteger, (Ptr) &line, 2)
  842.     ||     AEStream_CloseRecord(&aes)
  843.     ||     AEStream_Close(&aes, &newDesc)
  844.     ) {
  845.         AEStream_Close(&aes, nil);
  846.     } else {
  847.         AEPutParamDesc(reply, kOSAErrorRange, &newDesc)    ;
  848.         AEDisposeDesc(&newDesc);
  849.     }
  850. }
  851.  
  852. pascal OSErr DoScript(const AppleEvent *event, AppleEvent *reply, long refCon)
  853. {
  854. #if !defined(powerc) && !defined(__powerc)
  855. #pragma unused (refCon)
  856. #endif
  857.     Boolean    ranOK;
  858.     OSType    mode;
  859.     DescType    typeCode;
  860.     Size        size;
  861.     AEDesc    env;
  862.     
  863.     if (gRunningPerl) {
  864.         AppleEvent e[2];
  865.         
  866.         e[0] = *event;
  867.         e[1] = *reply;
  868.         
  869.         PtrAndHand((Ptr) e, (Handle) gWaitingScripts, 16);
  870.         
  871.         return AESuspendTheCurrentEvent(event);
  872.     }
  873.  
  874.     if (AEGetParamPtr(event, 'MODE', typeEnumerated, &typeCode, &mode, 4, &size))
  875.         mode = 'LOCL';
  876.     
  877.     switch (mode) {
  878.     case 'DPLX':
  879.     case 'RCTL':                
  880.         if (reply) {    /* Return immediately from initial request */
  881.             AEDuplicateDesc(event, &gDelayedScript);
  882.             
  883.             return 0;
  884.         }
  885.  
  886.         /* Fall through on delayed request */ 
  887.     case 'BATC':
  888.         freopen("Dev:AEVT", "r", stdin);
  889.         freopen("Dev:AEVT", "w", stdout);
  890.         freopen("Dev:AEVT:diag", "w", stderr); 
  891.         
  892.         Relay(event, nil, mode);
  893.     }
  894.     
  895.     if (AEGetParamDesc(event, 'ENVT', typeAEList, &env))
  896.         MakePerlEnviron(nil);
  897.     else {
  898.         MakePerlEnviron(&env);
  899.         AEDisposeDesc(&env);
  900.     }
  901.         
  902.     ranOK = RunScript(AEExtractor, (void *) event);
  903.     
  904.     switch (mode) {
  905.     case 'DPLX':
  906.     case 'RCTL':
  907.         /* Provoke controller to send last data event */
  908.         if (!gQuitting)
  909.             FlushAEVTs(nil);
  910.         break;
  911.     case 'BATC':
  912.     case 'LOCL':    
  913.         /* Get output data into reply event */
  914.         FlushAEVTs(reply);
  915.         
  916.         if (gPerlReply) {
  917.             HLock(gPerlReply);
  918.             AEPutParamPtr(
  919.                         reply, keyDirectObject,
  920.                         typeChar, *gPerlReply, GetHandleSize(gPerlReply));
  921.             DisposeHandle(gPerlReply);
  922.             gPerlReply = nil;
  923.         }
  924.         
  925.         AddErrorDescription(reply);
  926.     }
  927.     
  928.     return ranOK ? 0 : (gSyntaxError ? 1 : 2);
  929. }
  930.  
  931. pascal Boolean DoRuntime()
  932. {
  933.     FSSpec    spec;
  934.     short        res;
  935.     
  936.     if (gRuntimeScript = Get1NamedResource('TEXT', (StringPtr) "\p!")) {
  937.         spec.vRefNum     =     gAppVol;
  938.         spec.parID        =    gAppDir;
  939.         PLstrcpy(spec.name, LMGetCurApName());
  940.         strcpy(gPseudoFileName, FSp2FullPath(&spec));
  941.         
  942.         DetachResource(gRuntimeScript);
  943.     }
  944.  
  945.     return false;
  946. }
  947.  
  948. pascal void AddStandardScripts()
  949. {
  950.     short            runs;
  951.     short         index;
  952.     FSSpec        spec;
  953.  
  954.     if (sStandardScripts) {
  955.         runs = GetHandleSize((Handle) sStandardScripts) / sizeof(FSSpec)+1;
  956.         for (index = 0; index++ < runs; )
  957.             DeleteMenuItem(myMenus[perlM], pmStandard-1);
  958.     }
  959.     
  960.     spec.vRefNum    =    gAppVol;
  961.     spec.parID        =    gAppDir;
  962.     
  963.     FSpUp(&spec);
  964.     
  965.     for (runs = 0; runs++ < 2; Special2FSSpec(kExtensionFolderType, 0, 0, &spec)) {
  966.         if (FSpDown(&spec, (StringPtr) "\pMacPerl Scripts"))
  967.             continue;
  968.         if (FSpDown(&spec, (StringPtr) "\p"))
  969.             continue;
  970.         for (index = 1; !FSpIndex(&spec, index++); )
  971.             switch (GetDocType(&spec)) {
  972.             case kPreferenceDoc:
  973.                 /* We don't want preference files here. */
  974.             case kUnknownDoc:
  975.                 continue;
  976.             default:
  977.                 if (!sStandardScripts) {
  978.                     AppendMenu(myMenus[perlM], (StringPtr) "\p-(");
  979.                     PtrToHand((Ptr)&spec, (Handle *)&sStandardScripts, sizeof(FSSpec));
  980.                 } else
  981.                     PtrAndHand((Ptr)&spec, (Handle)sStandardScripts, sizeof(FSSpec));
  982.                 AppendMenu(myMenus[perlM], spec.name);
  983.             }
  984.     }
  985. }
  986.